(setq-local cursor-in-non-selected-windows nil))
(setq which-key--setup-p t))
- ;; Helper functions
+ ;; Timers
- (defsubst which-key/truncate-description (desc)
- "Truncate DESC description to `which-key-max-description-length'."
- (if (> (length desc) which-key-max-description-length)
- (concat (substring desc 0 which-key-max-description-length) "..")
- desc))
+ (defun which-key/start-open-timer ()
+ "Activate idle timer."
+ (which-key/stop-open-timer) ; start over
+ (setq which-key--open-timer
+ (run-with-idle-timer which-key-idle-delay t 'which-key/update)))
- (defun which-key/available-lines-per-page ()
- "Only works for minibuffer right now."
- (when (eq which-key-display-method 'minibuffer)
- (if (floatp max-mini-window-height)
- (floor (* (frame-text-lines)
- max-mini-window-height))
- max-mini-window-height)))
+ (defun which-key/stop-open-timer ()
+ "Deactivate idle timer."
+ (when which-key--open-timer (cancel-timer which-key--open-timer)))
- (defun which-key/replace-strings-from-alist (replacements)
- "Find and replace text in buffer according to REPLACEMENTS,
- which is an alist where the car of each element is the text to
- replace and the cdr is the replacement text."
- (dolist (rep replacements)
- (save-excursion
- (goto-char (point-min))
- (while (or (search-forward (car rep) nil t))
- (replace-match (cdr rep) t t)))))
+ (defun which-key/start-close-timer ()
+ "Activate idle timer."
+ (which-key/stop-close-timer) ; start over
+ (setq which-key--close-timer
+ (run-at-time which-key-close-buffer-idle-delay
+ nil 'which-key/hide-buffer)))
+
+ (defun which-key/stop-close-timer ()
+ "Deactivate idle timer."
+ (when which-key--close-timer (cancel-timer which-key--close-timer)))
- ;; in case I decide to add padding
- ;; (defsubst which-key/buffer-height (line-breaks) line-breaks)
+ ;; Update
+
+ (defun which-key/update ()
+ "Fill which-key--buffer with key descriptions and reformat.
+ Finally, show the buffer."
+ (let ((key (this-single-command-keys)))
+ (if (> (length key) 0)
+ (progn
+ (which-key/stop-close-timer)
+ (which-key/hide-buffer)
+ (let* ((buf (current-buffer))
+ ;; (bottom-or-top (member which-key-buffer-position '(top bottom)))
+ ;; get formatted key bindings
+ (fmt-width-cons (which-key/get-formatted-key-bindings buf key))
+ (formatted-keys (car fmt-width-cons))
+ (column-width (cdr fmt-width-cons))
+ (buffer-width (which-key/buffer-width column-width (window-width)))
+ ;; populate target buffer
+ (n-lines (which-key/populate-buffer formatted-keys column-width buffer-width)))
+ ;; show buffer
+ (when (which-key/show-buffer n-lines buffer-width)
+ (which-key/start-close-timer))))
+ ;; command finished maybe close the window
+ (which-key/hide-buffer))))
+
+ ;; Show/hide guide buffer
+
++;; Should this be used instead?
++;; (defun which-key/hide-buffer-display-buffer ()
++;; (when (window-live-p which-key--window)
++;; (delete-window which-key--window)))
++
+ (defun which-key/hide-buffer ()
+ (when (buffer-live-p which-key--buffer)
+ (delete-windows-on which-key--buffer)))
+
+ (defun which-key/show-buffer (height width)
+ "Show guide window.
+ Return nil if no window is shown, or if there is no need to start the
+ closing timer."
+ (cl-case which-key-display-method
- (minibuffer (which-key/show-buffer-minibuf height width))
- (side-window (which-key/show-buffer-db height width))))
++ (minibuffer (which-key/show-buffer-minibuffer height width))
++ (side-window (which-key/show-buffer-side-window height width))))
+
-(defun which-key/show-buffer-minibuf (height width)
++(defun which-key/show-buffer-minibuffer (height width)
+ nil)
+
-(defun which-key/show-buffer-db (height width)
++(defun which-key/show-buffer-side-window (height width)
+ (let* ((side which-key-buffer-position)
+ (alist (delq nil (list (when side (cons 'side side))
+ (when height (cons 'window-height height))
+ (when width (cons 'window-width width))))))
+ (display-buffer which-key--buffer (cons 'display-buffer-in-side-window alist))))
+
++;; Keep for popwin maybe (Used to work)
++;; (defun which-key/show-buffer-popwin (height width)
++;; "Using popwin popup buffer with dimensions HEIGHT and WIDTH."
++;; (popwin:popup-buffer which-key-buffer-name
++;; :height height
++;; :width width
++;; :noselect t
++;; :position which-key-buffer-position))
++
++;; (defun which-key/hide-buffer-popwin ()
++;; "Hide popwin buffer."
++;; (when (eq popwin:popup-buffer (get-buffer which-key--buffer))
++;; (popwin:close-popup-window)))
++
+ ;; Size functions
(defun which-key/buffer-width (column-width sel-window-width)
- (cond ((eq which-key-display-method 'minibuffer)
- (frame-text-cols))
- ((and (eq which-key-buffer-display-function 'display-buffer-in-side-window)
- (member which-key-buffer-position '(left right)))
- (min which-key-vertical-buffer-width column-width))
- ((eq which-key-buffer-display-function 'display-buffer-in-side-window)
- (frame-text-width))
- ;; ((eq which-key-buffer-display-function 'display-buffer-below-selected)
- ;; sel-window-width)
- (t nil)))
+ (cl-case which-key-display-method
- (minibuffer (which-key/buffer-width-minibuf column-width sel-window-width))
- (side-window (which-key/buffer-width-db column-width sel-window-width))))
++ (minibuffer (which-key/buffer-width-minibuffer column-width sel-window-width))
++ (side-window (which-key/buffer-width-side-window column-width sel-window-width))))
+
-(defun which-key/buffer-width-minibuf (column-width sel-window-width)
++(defun which-key/buffer-width-minibuffer (column-width sel-window-width)
+ (frame-text-cols))
+
-(defun which-key/buffer-width-db (column-width sel-window-width)
++(defun which-key/buffer-width-side-window (column-width sel-window-width)
+ (if (member which-key-buffer-position '(left right))
+ (min which-key-vertical-buffer-width column-width)
+ (frame-width)))
+
++;; (defun which-key/available-lines ()
++;; "Only works for minibuffer right now."
++;; (when (eq which-key-display-method 'minibuffer)
++;; (if (floatp max-mini-window-height)
++;; (floor (* (frame-text-lines)
++;; max-mini-window-height))
++;; max-mini-window-height)))
++
+ (defun which-key/available-lines ()
+ (cl-case which-key-display-method
- (minibuffer (which-key/available-lines-minibuf))
- (side-window (which-key/available-lines-db))))
++ (minibuffer (which-key/available-lines-minibuffer))
++ (side-window (which-key/available-lines-side-window))))
+
-(defun which-key/available-lines-minibuf ()
++(defun which-key/available-lines-minibuffer ()
+ "Only works for minibuffer right now."
+ (if (floatp max-mini-window-height)
+ (floor (* (frame-text-lines)
+ max-mini-window-height))
+ max-mini-window-height))
- (defun which-key/format-matches (unformatted max-len-key max-len-desc)
- "Turn each key-desc-cons in UNFORMATTED into formatted
- strings (including text properties), and pad with spaces so that
- all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the
- longest key and description in the buffer, respectively."
- (mapcar
- (lambda (key-desc-cons)
- (let* ((key (car key-desc-cons))
- (desc (cdr key-desc-cons))
- (group (string-match-p "^group:" desc))
- (desc (if group (substring desc 6) desc))
- (prefix (string-match-p "^Prefix" desc))
- (desc (if (or prefix group) (concat "+" desc) desc))
- (desc-face (if (or prefix group)
- 'font-lock-keyword-face 'font-lock-function-name-face))
- ;; (sign (if (or prefix group) "▶" "→"))
- (sign "→")
- (desc (which-key/truncate-description desc))
- ;; pad keys to max-len-key
- (padded-key (s-pad-left max-len-key " " key))
- (padded-desc (s-pad-right max-len-desc " " desc)))
- (format (concat (propertize "%s" 'face 'font-lock-constant-face) " "
- (propertize sign 'face 'font-lock-comment-face) " "
- (propertize "%s" 'face desc-face) " ")
- padded-key padded-desc)))
- unformatted))
-(defun which-key/available-lines-db ()
++(defun which-key/available-lines-side-window ()
+ (if (member which-key-buffer-position '(left right))
+ (frame-height)
+ ;; FIXME: change to something like (min which-*-height (calculate-max-height))
+ which-key-horizontal-buffer-height))
- ;; "Core" functions
+ ;; Buffer contents functions
(defun which-key/get-formatted-key-bindings (buffer key)
(let ((max-len-key 0) (max-len-desc 0)
unformatted max-len-key max-len-desc)))
(cons formatted (+ 4 max-len-key max-len-desc))))
+(defun which-key/create-page (avl-lines n-columns keys)
+ (let (lines
+ (n-keys (length keys))
+ (n-lines (min (ceiling (/ (float n-keys) n-columns)) avl-lines)))
+ (dotimes (i n-lines)
+ (setq lines
+ (push
+ (subseq keys (* i n-columns) (min n-keys (* (1+ i) n-columns)))
+ lines)))
+ (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n")))
+
(defun which-key/populate-buffer (formatted-keys column-width buffer-width)
- "Insert FORMATTED-STRINGS into buffer, breaking after BUFFER-WIDTH."
- (let* ((char-count 0) (line-breaks 0) (this-column 1)
- (width (if buffer-width buffer-width (frame-text-width)))
+ "Insert FORMATTED-STRINGS into which-key buffer, breaking after BUFFER-WIDTH."
+ (let* ((width (if buffer-width buffer-width (frame-text-width)))
(n-keys (length formatted-keys))
(n-columns (/ width column-width)) ;; integer division
- (avl-lines/page (which-key/available-lines-per-page))
- (n-lines (which-key/available-lines))
- (max-lines (ceiling (/ (float n-keys) n-columns)))
- (n-lines (if n-lines (min n-lines max-lines) max-lines))
- lines str-to-insert start end)
++ (avl-lines/page (which-key/available-lines))
+ (n-keys/page (when avl-lines/page (* n-columns avl-lines/page)))
+ (n-pages (if n-keys/page
+ (ceiling (/ (float n-keys) n-keys/page)) 1))
+ lines pages n-lines )
(when (> n-columns 0)
- (dotimes (i n-lines)
- (setq lines
- (push (subseq formatted-keys (* i n-columns) (min n-keys (* (1+ i) n-columns)))
- lines)))
- (setq str-to-insert (mapconcat (lambda (x) (apply 'concat x)) (reverse lines) "\n"))
+ (dotimes (p n-pages)
+ (setq pages
+ (push (which-key/create-page avl-lines/page n-columns
+ (subseq formatted-keys (* p n-keys/page)
+ (min (* (1+ p) n-keys/page) n-keys))) pages)))
+ (setq pages (reverse pages))
(if (eq which-key-display-method 'minibuffer)
- (let (message-log-max) (message "%s" str-to-insert))
+ (let (message-log-max) (message "%s" (car pages)))
- (insert (car pages))))
+ (with-current-buffer which-key--buffer
- (insert str-to-insert))))
++ (insert (car pages)))))
n-lines))
- (defun which-key/update ()
- "Fill which-key--buffer with key descriptions and reformat.
- Finally, show the buffer."
- (let ((key (this-single-command-keys)))
- (if (> (length key) 0)
- (progn
- (when which-key--close-timer (cancel-timer which-key--close-timer))
- (which-key/hide-buffer)
- (let* ((buf (current-buffer))
- (bottom-or-top (member which-key-buffer-position '(top bottom)))
- ;; get formatted key bindings
- (fmt-width-cons (which-key/get-formatted-key-bindings buf key))
- (formatted-keys (car fmt-width-cons))
- (column-width (cdr fmt-width-cons))
- (buffer-width (which-key/buffer-width column-width (window-width)))
- n-lines)
- ;; populate target buffer
- (setq n-lines (which-key/populate-buffer
- formatted-keys column-width buffer-width))
- ;; show buffer
- (unless (eq which-key-display-method 'minibuffer)
- (setq which-key--window (which-key/show-buffer n-lines buffer-width)
- which-key--close-timer (run-at-time
- which-key-close-buffer-idle-delay
- nil 'which-key/hide-buffer)))))
- ;; command finished maybe close the window
- (which-key/hide-buffer))))
-
- ;; Timers
+ (defun which-key/replace-strings-from-alist (replacements)
+ "Find and replace text in buffer according to REPLACEMENTS,
+ which is an alist where the car of each element is the text to
+ replace and the cdr is the replacement text."
+ (dolist (rep replacements)
+ (save-excursion
+ (goto-char (point-min))
+ (while (or (search-forward (car rep) nil t))
+ (replace-match (cdr rep) t t)))))
- (defun which-key/start-open-timer ()
- "Activate idle timer."
- (when which-key--open-timer (cancel-timer which-key--open-timer)); start over
- (setq which-key--open-timer
- (run-with-idle-timer which-key-idle-delay t 'which-key/update)))
+ (defun which-key/format-matches (unformatted max-len-key max-len-desc)
+ "Turn each key-desc-cons in UNFORMATTED into formatted
+ strings (including text properties), and pad with spaces so that
+ all are a uniform length. MAX-LEN-KEY and MAX-LEN-DESC are the
+ longest key and description in the buffer, respectively."
+ (mapcar
+ (lambda (key-desc-cons)
+ (let* ((key (car key-desc-cons))
+ (desc (cdr key-desc-cons))
+ (group (string-match-p "^group:" desc))
+ (desc (if group (substring desc 6) desc))
+ (prefix (string-match-p "^Prefix" desc))
+ (desc (if (or prefix group) (concat "+" desc) desc))
+ (desc-face (if (or prefix group)
+ 'font-lock-keyword-face 'font-lock-function-name-face))
+ ;; (sign (if (or prefix group) "▶" "→"))
+ (sign "→")
+ (desc (which-key/truncate-description desc))
+ ;; pad keys to max-len-key
+ (padded-key (s-pad-left max-len-key " " key))
+ (padded-desc (s-pad-right max-len-desc " " desc)))
+ (format (concat (propertize "%s" 'face 'font-lock-constant-face) " "
+ (propertize sign 'face 'font-lock-comment-face) " "
+ (propertize "%s" 'face desc-face) " ")
+ padded-key padded-desc)))
+ unformatted))
- (defun which-key/stop-open-timer ()
- "Deactivate idle timer."
- (cancel-timer which-key--open-timer))
-
- ;; placeholder for page flipping
- ;; (defun which-key/start-next-page-timer ())
-
- ;; Display functions
-
- (defun which-key/show-buffer-display-buffer (height width)
- (let ((side which-key-buffer-position) alist)
- (setq alist (list (when side (cons 'side side))
- (when height (cons 'window-height height))
- (when width (cons 'window-width width))))
- (display-buffer "*which-key*" (cons which-key-buffer-display-function alist))))
-
- (defun which-key/hide-buffer-display-buffer ()
- (when (window-live-p which-key--window)
- (delete-window which-key--window)))
-
- (defun which-key/show-buffer-popwin (height width)
- "Using popwin popup buffer with dimensions HEIGHT and WIDTH."
- (popwin:popup-buffer which-key-buffer-name
- :height height
- :width width
- :noselect t
- :position which-key-buffer-position))
-
- (defun which-key/hide-buffer-popwin ()
- "Hide popwin buffer."
- (when (eq popwin:popup-buffer (get-buffer which-key--buffer))
- (popwin:close-popup-window)))
-
- (defun which-key/make-display-method-aliases (method)
- (cond
- ((eq method 'minibuffer)
- (defun which-key/hide-buffer ()))
- ((member method '(popwin display-buffer))
- (defalias 'which-key/show-buffer
- (intern (concat "which-key/show-buffer-" (symbol-name method))))
- (defalias 'which-key/hide-buffer
- (intern (concat "which-key/hide-buffer-" (symbol-name method)))))
- (t (error "error: Invalid choice for which-key-display-method"))))
+ (defsubst which-key/truncate-description (desc)
+ "Truncate DESC description to `which-key-max-description-length'."
+ (if (> (length desc) which-key-max-description-length)
+ (concat (substring desc 0 which-key-max-description-length) "..")
+ desc))
(provide 'which-key)
projects / emacs.git / commitdiff